home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #15
/
Monster Media Number 15 (Monster Media)(July 1996).ISO
/
prog_d
/
tpop3.zip
/
MSGDCD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-03-29
|
9KB
|
366 lines
unit Msgdcd;
interface
uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, StdCtrls,
Buttons, ExtCtrls, Dialogs, SysUtils, MsgUtils,
Mime;
type
EDecodeError = class(Exception);
TEncMethod = (emNone,emBase64,emQtPrn);
TSection = class
EncMethod : TEncMethod;
FileName : string;
MIMEType : string;
Data : TMemoryStream;
constructor Create;
destructor Destroy;
end;
TMsgProcessor = class(TForm)
Panel1: TPanel;
Memo1: TMemo;
SaveButton: TBitBtn;
DecodeButton: TBitBtn;
CloseButton: TBitBtn;
SaveDialog1: TSaveDialog;
procedure DecodeButtonClick(Sender: TObject);
procedure SaveButtonClick(Sender: TObject);
private
{ Private declarations }
MsgStream : TMemoryStream;
Sections : TList;
MsgLines : TStrings;
Headers : TStrings;
procedure FillHeaders;
procedure ProcessSectionLines(Lines : TStrings);
procedure HandleSingleSection;
procedure HandleMultipleSections;
procedure ProcessSections;
procedure Process;
function GetFirstPart(const s : string) : string;
function GetEncMethod(Hdr : TStrings) : TEncMethod;
public
{ Public declarations }
constructor Create(AOwner : TComponent; AStream : TMemoryStream);
destructor Destroy; override;
end;
var
MsgProcessor: TMsgProcessor;
AttachmentsDir : string;
implementation
{$R *.DFM}
{TSection}
constructor TSection.Create;
begin
inherited Create;
Data:=TMemoryStream.Create;
end;
destructor TSection.Destroy;
begin
Data.Free;
inherited Destroy;
end;
constructor TMsgProcessor.Create(AOwner : TComponent; AStream : TMemoryStream);
var
OutFileName : string;
begin
inherited Create(AOwner);
MsgStream:=AStream;
MsgLines:=TStringList.Create;
MsgStream.Position:=0;
try
MsgLines.LoadFromStream(MsgStream);
except
on EListError do
begin
if MessageDlg('Unable to process this message because it is too large'^M^J+
'Do you want to save it as file?',mtError,[mbYes,mbCancel],0)=mrYes then
begin
AttachmentsDir:=AddBackSlash(AttachmentsDir);
OutFileName:=AttachmentsDir+'message.txt';
if InputQuery('Saving a Message','Enter the name of output file:',
OutFileName) then
MsgStream.SaveToFile(OutFileName);
end;
DecodeButton.Enabled:=false;
end;
end;
try
Memo1.Lines:=MsgLines;
except
MessageDlg('Text is too large. Only part will be displayed',
mtError,[mbOk],0);
end;
MsgStream.Position:=0;
Headers:=TStringList.Create;
Sections:=TList.Create;
end;
destructor TMsgProcessor.Destroy;
var
i : Integer;
begin
for i:=Sections.Count-1 DownTo 0 do
TSection(Sections[i]).Free;
Sections.Free;
Headers.Free;
MsgLines.Free;
inherited Destroy;
end;
procedure TMsgProcessor.FillHeaders;
var
s : string;
begin
Headers.Clear;
while (MsgLines.Count<>0) and (MsgLines[0]<>'') do
begin
s:=MsgLines[0];
Headers.Add(s);
MsgLines.Delete(0);
end;
end;
function TMsgProcessor.GetFirstPart(const s : string) : string;
{Gets first part of the Header line, where descr is truncated}
var
sLen : byte absolute s;
i : byte;
begin
Result:='';
i:=1;
while (i<=sLen) and not (s[i] in [' ',';']) do
begin
Result:=Concat(Result,s[i]);
Inc(i);
end;
Result:=TrimStr(Result);
end;
function TMsgProcessor.GetEncMethod(Hdr : TStrings) : TEncMethod;
var
s : string;
begin
s:=UpperCase(GetHeaderValue(Hdr,'Content-Transfer-Encoding'));
if s='BASE64' then
Result:=emBase64
else
if s='QUOTED-PRINTABLE' then
Result:=emQtPrn
else
Result:=emNone;
end;
procedure TMsgProcessor.ProcessSectionLines(Lines : TStrings);
var
LocalHeaders : TStrings;
TempSection : TSection;
s : string;
begin
LocalHeaders:=TStringList.Create;
try
while (Lines.Count<>0) and (Lines[0]<>'') do
begin
s:=Lines[0];
LocalHeaders.Add(s);
Lines.Delete(0);
end;
TempSection:=TSection.Create;
s:=GetHeaderValue(LocalHeaders,'Content-Type');
if s=InvStr then
begin
TempSection.Free;
raise EDecodeError.Create('Missing required field - Content-Type');
end;
TempSection.MimeType:=GetFirstPart(s);
if Pos('PARTIAL',UpperCase(TempSection.MimeType))>0 then
raise EDecodeError.Create('Unable to handle multipart messages');
s:=GetParameter('name',s);
if s<>InvStr then
TempSection.FileName:=s;
s:=GetHeaderValue(LocalHeaders,'Content-Disposition');
s:=GetParameter('filename',s);
if s<>InvStr then
TempSection.FileName:=s;
TempSection.EncMethod:=GetEncMethod(LocalHeaders);
Lines.SaveToStream(TempSection.Data);
TempSection.Data.Position:=0;
Sections.Add(TempSection);
finally
LocalHeaders.Free;
end;
end;
procedure TMsgProcessor.HandleSingleSection;
var
TempLines : TStrings;
begin
TempLines:=TStringList.Create;
TempLines.AddStrings(Headers);
try
TempLines.AddStrings(MsgLines);
ProcessSectionLines(TempLines);
finally
TempLines.free;
end;
end;
procedure TMsgProcessor.HandleMultipleSections;
var
TempLines : TStrings;
Boundary : string;
s : string;
i : Integer;
Finished : boolean;
BLen : byte;
begin
s:=GetHeaderValue(Headers,'Content-Type');
Boundary:='';
if Pos('MULTIPART',UpperCase(s))<>0 then
Boundary:=GetParameter('Boundary',s);
if Boundary=InvStr then
raise EDecodeError.Create('Miltipart message does not contain'^M^J+
' the ''boundary'' parameter.');
if Boundary<>'' then
begin
if Boundary<>'' then Boundary:=Concat('--',Boundary);
BLen:=Length(Boundary);
try
TempLines:=TStringList.Create;
i:=0;
while (i<MsgLines.Count) and (Copy(MsgLines[i],1,BLen)<>Boundary) do
Inc(i);
if i=MsgLines.Count then
raise EDecodeError.Create('Invalid format.');
repeat
Inc(i);
TempLines.Clear;
while (i<MsgLines.Count) and (Copy(MsgLines[i],1,BLen)<>Boundary) do
begin
TempLines.Add(MsgLines[i]);
Inc(i);
end;
Finished:=(i=MsgLines.Count) or (MsgLines[i]=Concat(Boundary,'--'));
ProcessSectionLines(TempLines);
until Finished;
finally
TempLines.Free;
end;
end
else
HandleSingleSection;
end;
procedure TMsgProcessor.ProcessSections;
var
i : Integer;
TempLines : TStringList;
TempStream : TMemoryStream;
Section : TSection;
begin
MsgLines.Clear;
TempLines:=TStringList.Create;
TempStream:=TMemoryStream.Create;
try
for i:=0 to Sections.Count-1 do
begin
Section:=TSection(Sections[i]);
case Section.EncMethod of
emNone :
begin
TempLines.LoadFromStream(Section.Data);
MsgLines.AddStrings(TempLines);
end;
emBase64:
begin
TempLines.LoadFromStream(Section.Data);
TrimStringList(TempLines);
TempStream.Clear;
with TBase64.Create(TempStream,TempLines) do
try
Decode;
finally
free;
end;
TempStream.SaveToFile(AttachmentsDir+Section.FileName);
MsgLines.Add('--Section '+IntToStr(i)+'--');
MsgLines.Add('Decoded and saved as '+AttachmentsDir+Section.FileName);
MsgLines.Add('----');
end;
emQtPrn :
begin
TempLines.LoadFromStream(Section.Data);
TrimStringList(TempLines);
TempStream.Clear;
with TQuotedPrintable.Create(TempStream,TempLines) do
try
Decode;
finally
free;
end;
TempStream.Position:=0;
TempLines.Clear;
TempLines.LoadFromStream(TempStream);
MsgLines.AddStrings(TempLines);
end;
end;
end;
finally
TempStream.Free;
TempLines.Free;
end;
end;
procedure TMsgProcessor.Process;
var
TempSection : TSection;
i : Integer;
begin
FillHeaders;
if GetHeaderValue(Headers,'Mime-Version')<>'1.0' then
HandleSingleSection
else
HandleMultipleSections;
ProcessSections;
end;
procedure TMsgProcessor.DecodeButtonClick(Sender: TObject);
begin
AttachmentsDir:=AddBackSlash(AttachmentsDir);
Memo1.Cursor:=crHourGlass;
Panel1.Cursor:=crHourGlass;
Panel1.Enabled:=false;
try
Process;
Memo1.Lines:=MsgLines;
finally
Memo1.Cursor:=crDefault;
Panel1.Cursor:=crDefault;
Panel1.Enabled:=true;
DecodeButton.Enabled:=false;
end;
end;
procedure TMsgProcessor.SaveButtonClick(Sender: TObject);
begin
SaveDialog1.InitialDir:=AttachmentsDir;
if SaveDialog1.Execute then
begin
MsgStream.SaveToFile(SaveDialog1.FileName);
end;
end;
initialization
AttachmentsDir:='';
end.